Código fuente de '3 funciones con fechas.asp'
<html>
<head>
<title>3 funciones con fechas - Códigos asp, programacion asp, descargas asp, rutinas asp</title>
</head>
<body style="font-family: Arial; font-size: 9pt">
<p align="center"><b><font size="3">3 funciones con fechas</font></b></p>
Aquí tienes 3 funciones que trabajan con fechas:
<%
' =========================================================================
' Wrote this function because the VBscript date formatting left me missing one format.
' That is "Month Day, Year" and "Month Year"
' "sDate" is a valid date, "bDay" is TRUE/FALSE to return DAY, and "bYear" is
' TRUE/FALSE to return YEAR
' =========================================================================
function FormatoFecha(sDate, bDay, bYear)
dim theMonths, iMonth, iDay, iYear
theMonths = Array("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
iMonth = month(sDate)
iDay = day(sDate)
iYear = year(sDate)
' Remember to substract one from iMonth due to array index of 0
FormatoFecha = theMonths(iMonth-1)
if bDay and bYear then
FormatoFecha = iDay & " de " & FormatoFecha & " " & " de " & iYear
elseif bDay and not bYear then
FormatoFecha = iDay & " " & FormatoFecha
elseif not bDay and bYear then
FormatoFecha = FormatoFecha & " de " & iYear
end if
end function
' =================================================================
' =================================================================
' This will return total number of years and months
' "iMonths" is the total number of months
' =================================================================
function MesesAAnyos(iMonths)
on error resume next
iTotalYears = iMonths\12
iTmpMonths = iTotalYears * 12
iTotalMonths = iMonths - iTmpMonths
if iTotalYears > 1 then
sYears = " Años"
else
sYears = " Año"
end if
if iTotalMonths > 1 then
sMonths = " Meses"
else
sMonths = " Mes"
end if
if iTotalYears > 0 and iTotalMonths > 0 then
MesesAAnyos = iTotalYears & sYears & " y " & iTotalMonths & sMonths
elseif iTotalYears > 0 and iTotalMonths = 0 then
MesesAAnyos = iTotalYears & sYears
elseif iTotalYears = 0 and iTotalMonths > 0 then
MesesAAnyos = iTotalMonths & sMonths
else
MesesAAnyos = "ERROR"
end if
end function
' =================================================================
' =================================================================
' Determine if passed date "vDate" falls on a holiday
' =================================================================
function EsFiesta(vDate)
Dim Y, iNumHol, Dy, N, M
Y = Year(vDate)
M = Month(vDate)
EsFiesta = False
Select Case M
Case 1
'---- NewYears day
If Day(vDate) = 1 Or (Day(vDate) = 2 And WeekDay(vDate) = vbMonday) Then
EsFiesta = True
Else
'---- Martin Luther King day
If vDate = FirstMonday(Y, 1) + (2 * 7) Then
EsFiesta = True
End If
End If
case 3,4
'---- Good Friday
if isGoodFriday(vDate) then
EsFiesta = True
sHolidayName = "GOOD FRIDAY"
else
sHolidayName = ""
end if
Case 2
'---- Presidents day
If vDate = FirstMonday(Y, 2) + (2 * 7) Then EsFiesta = True
Case 5
'---- Memorial day (last week of month)
Dy = FirstMonday(Y, 5) + (4 * 7)
If Month(Dy) <> 5 Then Dy = Dy - 7
If vDate = Dy Then EsFiesta = True
Case 7
'---- Independance day
If Day(vDate) = 4 Or (Day(vDate) = 3 And WeekDay(vDate) = vbFriday) Or (Day(vDate) = 5 And WeekDay(vDate) = vbMonday) Then EsFiesta = True
Case 9
'---- Labor day
If vDate = FirstMonday(Y, 9) Then EsFiesta = True
Case 10
'---- Columbus day
If vDate = FirstMonday(Y, 10) + 7 Then EsFiesta = True
Case 11
'---- Veterans day
If Day(vDate) = 11 Or (Day(vDate) = 10 And WeekDay(vDate) = vbFriday) Or (Day(vDate) = 12 And WeekDay(vDate) = vbMonday) Then
EsFiesta = True
Else
'---- Thanksgiving day (last week of month)
Dy = FirstMonday(Y, 11) + 3 + (3 * 7)
If Month(Dy) <> 11 Then Dy = Dy - 7
If vDate = Dy Then EsFiesta = True
End If
Case 12
'---- Christmas day
If Day(vDate) = 25 Or (Day(vDate) = 24 And WeekDay(vDate) = vbFriday) Or (Day(vDate) = 26 And WeekDay(vDate) = vbMonday) Or (Day(vDate) = 31 And WeekDay(vDate) = vbFriday) Then EsFiesta = True
End Select
End function
' Used by EsFiesta sub
Function FirstMonday(Y, M)
Dim lDay, N
lDay = DateSerial(Y, M, 1)
For N = lDay To lDay + 6
If N Mod 7 = vbMonday Then Exit For
Next
FirstMonday = N
End Function
' Used by EsFiesta sub
' Determine if date is Good Friday
function isGoodFriday(vDate)
' Calculation adapted from algorithm at http://www.smart.net/~mmontes/carter.html
dim iCentury, iYear2, iG, iK, iI, iJ, iL, iEasterMonth, iEasterDay, dtGoodFriday
' Find date of Easter
iYear2 = year(vDate)
iCentury = iYear2\100
iG = iYear2 mod 19
iK = (iCentury - 17)\25
iI = (iCentury - iCentury\4 - (iCentury - iK)\3 + 19*iG + 15) mod 30
iI = iI - (iI\28)*(1 - (iI\28)*(29\(iI + 1))*((21 - iG)\11))
iJ = (iYear2 + iYear2\4 + iI + 2 - iCentury + iCentury\4) mod 7
iL = iI - iJ
iEasterMonth = 3 + (iL + 40)\44
iEasterDay = iL + 28 - 31*(iEasterMonth\4)
' Good Friday is 2 days before Easter
dtGoodFriday = datevalue((iEasterMonth & "/" & iEasterDay & "/" & iYear2)) - 2
if vDate = dtGoodFriday then
isGoodFriday = True
else
isGoodFriday = False
end if
end function
' =================================================================
response.write "<br><b>FormatoFecha</b>"
response.write "<br>FormatoFecha(""1/4/2004"",true,true)= " & FormatoFecha("1/4/2004",true,true)
response.write "<br>FormatoFecha(""1/4/2004"",true,false)= " & FormatoFecha("1/4/2004",true,false)
response.write "<br>FormatoFecha(""1/4/2004"",false,true)= " & FormatoFecha("1/4/2004",false,true)
response.write "<br>FormatoFecha(""1/4/2004"",false,false)= " & FormatoFecha("1/4/2004",false,false)
response.write "<br><b>EsFiesta</b>"
response.write "<br>EsFiesta(""1/1/2004"")= " &EsFiesta("1/1/2004")
response.write "<br><b>MesesAAnyos</b>"
response.write "<br>MesesAAnyos(123)= " & MesesAAnyos(123)
%>
</body>
</html>